by Orlando Moreira / upgrade from Matt Terry code (1 Submission)
Category: String Manipulation
Compatability: VB.NET
Difficulty: Unknown Difficulty
Originally Published: Wed 4th February 2009
Date Added: Mon 8th February 2021
Rating: 
(1 Votes)
Shrinks long path/file name to shortened C:\Program Files\...\prog.exe for display purposes.
VBcoders
'MaxChars argument is the length of the displayable path name to return
'ShrinkChar optional argument is the character to use for shortened version ("." is default)
Private Function ShrinkFileName(ByVal NameToShrink As String, _
ByVal MaxChars As Integer, Optional ByVal ShrinkChar As String = ".") As String
Dim HideChar As String, szFileName As String, szDir() As String, R As Integer
Dim nDirs As Integer, nDir1 As Integer, nDir2 As Integer, nDir3 As Integer, nDir4 As Integer, iCount As Integer
If NameToShrink.Length < MaxChars Then
'No change needed
ShrinkFileName = NameToShrink
Exit Function
End If
'Set Hide Character
If ShrinkChar.Length > 0 Then
HideChar = ShrinkChar.Substring(0, 1) & ShrinkChar.Substring(0, 1) & ShrinkChar.Substring(0, 1)
Else
HideChar = "." & "." & "."
End If
'Split the file name
szDir = NameToShrink.Split("\")
nDirs = szDir.Length - 1
If nDirs < 1 Then
'FileName can't be shrunk well, just
'chop off beginning characters to fit
R = NameToShrink.Length - MaxChars
If R < 0 Then R = 0
ShrinkFileName = NameToShrink.Substring(R)
Exit Function
End If
'Re-add the "\"s
For iCount = 0 To nDirs
szDir(iCount) = "\" & szDir(iCount)
Next iCount
If szDir(nDirs).Length >= MaxChars Or szDir(0).Length >= MaxChars Then
'FileName can't be shrunk well, just
'chop off the end of the file name
'to fit.
ShrinkFileName = szDir(nDirs).Substring(0, MaxChars)
Exit Function
End If
'Start the shrunken FileName
ShrinkFileName = szDir(0)
'Get Section lengths
nDir1 = szDir(0).Length 'Drive Letter
nDir2 = szDir(1).Length 'First Directory or File Name
szFileName = szDir(1)
If nDirs > 1 Then
nDir3 = szDir(2).Length 'Second Directory of File Name
szFileName = szDir(2)
Else
nDir3 = 0
End If
If nDirs > 2 Then
nDir4 = szDir(nDirs).Length 'File Name
szFileName = szDir(nDirs)
Else
nDir4 = 0
End If
'Worst case scenario (of remaining)
If nDir1 + szFileName.Length + HideChar.Length > MaxChars Then
ShrinkFileName = szFileName
Exit Function
End If
'Next best
ShrinkFileName = ShrinkFileName & HideChar & szFileName
If ShrinkFileName.Length + nDir2 >= MaxChars Or nDir2 < 1 Then
Exit Function
Else
ShrinkFileName = szDir(0) & szDir(1) & HideChar & szFileName
End If
'Next best
If ShrinkFileName.Length + nDir3 >= MaxChars Or nDir3 < 1 Then
Exit Function
Else
ShrinkFileName = szDir(0) & szDir(1) & szDir(2) & HideChar & szFileName
End If
'Best case scenario
If ShrinkFileName.Length + nDir4 <= MaxChars Then
ShrinkFileName = szDir(0) & szDir(1) & szDir(2) & szDir(3) & HideChar & szFileName
End If
End Function
No comments have been posted about Shrinks long path/file name to shortened C:\Program Files\...\prog.exe for display purposes.. Why not be the first to post a comment about Shrinks long path/file name to shortened C:\Program Files\...\prog.exe for display purposes..